home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / BORL_TIP / TI100 / TI675.ASC < prev    next >
Text File  |  1992-09-03  |  6KB  |  331 lines

  1.  
  2.  
  3.  
  4.  
  5.  
  6.  
  7.  
  8.   PRODUCT  :  Turbo Pascal                           NUMBER  :  675
  9.   VERSION  :  6.0
  10.        OS  :  MS/PC DOS
  11.      DATE  :  September 3, 1992                        PAGE  :  1/5
  12.  
  13.     TITLE  :  Simple Pick List Example
  14.  
  15.  
  16.  
  17.  
  18.   {
  19.  
  20.   The following example is to demonstrate the use of a Pick List.
  21.   This Pick List will read a line of data and validate the field
  22.   as well as keep a history of valid commands.
  23.  
  24.   }
  25.   {$X+}
  26.   Program PickListExample;
  27.  
  28.   uses Objects, App, Menus, Drivers, Views, Dialogs, MsgBox;
  29.  
  30.   type
  31.     YourKeySet = set of char;
  32.  
  33.   const
  34.      cmMakeDialog = 101;
  35.      ValidSet  : YourKeySet = [#0..#31,'0'..'9'];
  36.  
  37.   type
  38.  
  39.     PFInputLine = ^TFInputLine;
  40.     TFInputLine = object(TInputLine)
  41.       ValidKeys : YourKeySet;
  42.       constructor Init(var Bounds: TRect; AMaxLen: integer;
  43.                        ChrSet: YourKeySet);
  44.       procedure HandleEvent(var Event: TEvent); virtual;
  45.       procedure GetData(var Rec); virtual;
  46.       procedure SetData(var Rec); virtual;
  47.       function DataSize: word; virtual;
  48.     end;
  49.  
  50.   PMyApp = ^TMyApp;
  51.   TMyApp = object(TApplication)
  52.     procedure InitMenuBar;virtual;
  53.     procedure InitStatusLine;virtual;
  54.     procedure MakeDialog;
  55.     procedure HandleEvent(var Event: TEvent);virtual;
  56.    end;
  57.  
  58.   constructor TFInputLine.Init(var Bounds: TRect; AMaxLen: integer;
  59.                                ChrSet: YourKeySet);
  60.   begin
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  
  74.   PRODUCT  :  Turbo Pascal                           NUMBER  :  675
  75.   VERSION  :  6.0
  76.        OS  :  MS/PC DOS
  77.      DATE  :  September 3, 1992                        PAGE  :  2/5
  78.  
  79.     TITLE  :  Simple Pick List Example
  80.  
  81.  
  82.  
  83.  
  84.     TInputLine.Init(Bounds,AMaxLen);
  85.     ValidKeys:= ChrSet;
  86.   end;
  87.  
  88.   procedure TFInputLine.HandleEvent(var Event: TEvent);
  89.   {
  90.     Data validation handle event:
  91.     Please note that validation happens BEFORE the parent
  92.     is called. This ensures that the key is not trapped by
  93.     the parent method.
  94.   }
  95.  
  96.   var
  97.     Number : longint;
  98.     Code : integer;
  99.   begin
  100.     case Event.What of
  101.       evKeyDown :
  102.         begin
  103.           if not(Event.CharCode in ValidKeys) then
  104.             ClearEvent(Event)
  105.            else
  106.              if Data^ <> '' then
  107.                begin
  108.                  val(Data^, Number, Code);
  109.                  if (Code <> 0) or (Number < 0) or (Number > 65535)
  110.   then
  111.                    begin
  112.                      Data^ := '';
  113.                      MessageBox('Valid number is 0 to
  114.   65536.',nil,mfOkButton);
  115.                      ClearEvent(Event);
  116.                    end;
  117.                end;
  118.         end;
  119.     end;
  120.     TInputLine.HandleEvent(Event);
  121.   end;
  122.  
  123.   procedure TFInputLine.GetData(var Rec);
  124.   var
  125.     Code : integer;
  126.   begin
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.   PRODUCT  :  Turbo Pascal                           NUMBER  :  675
  141.   VERSION  :  6.0
  142.        OS  :  MS/PC DOS
  143.      DATE  :  September 3, 1992                        PAGE  :  3/5
  144.  
  145.     TITLE  :  Simple Pick List Example
  146.  
  147.  
  148.  
  149.  
  150.     Val(Data^,word(Rec), Code);
  151.   end;
  152.  
  153.   procedure TFInputLine.SetData(var Rec);
  154.   begin
  155.     Str(word(Rec),Data^);
  156.   end;
  157.  
  158.   function TFInputLine.DataSize: word;
  159.   begin
  160.     DataSize := SizeOf(word);
  161.   end;
  162.  
  163.   procedure TMyApp.InitMenuBar;
  164.     var R: TRect;
  165.   begin
  166.     GetExtent(R);
  167.     R.B.Y := R.A.Y + 1;
  168.     MenuBar := New(PMenuBar, Init(R, NewMenu(
  169.       NewSubMenu('~T~est', hcNoContext, NewMenu(
  170.         NewItem('~D~ialog','F2',kbF2,cmMakeDialog,hcNoContext,
  171.         NewLine(
  172.         NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
  173.         nil)))),nil))));
  174.   end;
  175.  
  176.   procedure TMyApp.MakeDialog;
  177.   var
  178.    R : TRect;
  179.    Dialog : PDialog;
  180.    InputLine : PInputLine;
  181.    Lable,Hist : PView;
  182.   begin
  183.    GetExtent(R);
  184.    R.Assign(10,5,60,15);
  185.    Dialog := New(PDialog,Init(R,'Demo Dialog'));
  186.    With Dialog^ do
  187.      begin
  188.        R.Assign(5,4,20,5);
  189.        InputLine := New(PFInputLine,Init(R,15,ValidSet));
  190.        Insert(InputLine);
  191.        R.Assign(5,3,20,4);
  192.        Lable := New(PLabel,Init(R,'InputLine',Inputline));
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206.   PRODUCT  :  Turbo Pascal                           NUMBER  :  675
  207.   VERSION  :  6.0
  208.        OS  :  MS/PC DOS
  209.      DATE  :  September 3, 1992                        PAGE  :  4/5
  210.  
  211.     TITLE  :  Simple Pick List Example
  212.  
  213.  
  214.  
  215.  
  216.        Insert(Lable);
  217.        R.Assign(21,4,23,5);
  218.        Hist := New(PHistory,Init(R,InputLine,0));
  219.        Insert(Hist);
  220.      end;
  221.    Desktop^.ExecView(Dialog);
  222.    Dispose(Dialog,Done);
  223.   end;
  224.  
  225.   procedure TMyApp.InitStatusLine;
  226.   var
  227.    R : TRect;
  228.   begin
  229.    GetExtent(R);
  230.    R.A.Y := R.B.Y - 1;
  231.    StatusLine :=  New(PStatusLine,Init(R,
  232.                     NewStatusDef(0,$FFFF,
  233.                       NewStatusKey('~A~lt-X',kbAltX,cmQuit,
  234.                   nil),nil)));
  235.   end;
  236.  
  237.   procedure TMyApp.HandleEvent(var Event: TEvent);
  238.   begin
  239.     TApplication.HandleEvent(Event);
  240.     if Event.What = evCommand then
  241.     begin
  242.       case Event.Command of
  243.         cmMakeDialog: MakeDialog;
  244.       else
  245.         Exit;
  246.       end;
  247.       ClearEvent(Event);
  248.     end;
  249.   end;
  250.  
  251.   var
  252.    MyApp: TMyApp;
  253.  
  254.   begin
  255.    MyApp.Init;
  256.    MyApp.Run;
  257.    MyApp.Done;
  258.   end.
  259.  
  260.  
  261.  
  262.  
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  
  269.  
  270.  
  271.  
  272.   PRODUCT  :  Turbo Pascal                           NUMBER  :  675
  273.   VERSION  :  6.0
  274.        OS  :  MS/PC DOS
  275.      DATE  :  September 3, 1992                        PAGE  :  5/5
  276.  
  277.     TITLE  :  Simple Pick List Example
  278.  
  279.  
  280.  
  281.  
  282.   DISCLAIMER: You have the right to use this technical information
  283.   subject to the terms of the No-Nonsense License Statement that
  284.   you received with the Borland product to which this information
  285.   pertains.
  286.  
  287.  
  288.  
  289.  
  290.  
  291.  
  292.  
  293.  
  294.  
  295.  
  296.  
  297.  
  298.  
  299.  
  300.  
  301.  
  302.  
  303.  
  304.  
  305.  
  306.  
  307.  
  308.  
  309.  
  310.  
  311.  
  312.  
  313.  
  314.  
  315.  
  316.  
  317.  
  318.  
  319.  
  320.  
  321.  
  322.  
  323.  
  324.  
  325.  
  326.  
  327.  
  328.  
  329.  
  330.  
  331.